trust <- lm(trust_diff_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
discomfort_marr <- lm(discomfort_outparty_marriage_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
discomfort_friend <- lm(discomfort_outparty_friends_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
discomfort_neighbor <- lm(discomfort_outparty_neighbors_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
threat <- lm(threat_outparty_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
neg_par <- lm(neg_partisan_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
models_list <- list(therm, trust, discomfort_marr, discomfort_friend, discomfort_neighbor, threat, neg_par)
names_list <- c("Feeling Thermometer", "Trust Difference",
"Discomfort Marriage", "Discomfort
Friends", "Discomfort Neighbors",
"Outparty Threat", "Negative Partisanship")
affpol_components <- plot_generate_7(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components <- plot_generate_7(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) #+ theme_minimal()
#### Seven Models Fix ####
plot_generate_7b <- function(models_list, names_list, plot_title, xlim) {
models <- lapply(models_list, function(model) {
print("Tidying model")
tidy_model <- broom::tidy(coeftest(model, vcov = sandwich::vcovHC, type = "HC1"))
print(class(tidy_model))
tidy_model %>%
filter(term != "(Intercept)")
})
print("Tidied all models")
names_df <- lapply(names_list, function(name) {
data.frame(model = rep(name, nrow(models[[1]])))
})
models <- Map(cbind, models, names_df)
models <- do.call(rbind, models)
print("Creating dwplot")
base_plot <- dotwhisker::dwplot(models,
vline = geom_vline(xintercept = 0, linetype = "dashed", color = "black"),
dot_args = list(size = 5),
whisker_args = list(size = 0.7),
dodge_size = 1)
print("After dwplot")
print(class(base_plot))
base_plot <- dotwhisker::relabel_predictors(
base_plot,
treat_long_collapse2 = "Long Video vs. Placebo"
)
print("After relabel_predictors")
print(class(base_plot))
plot <- base_plot +
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals") +
xlim(xlim) +
scale_colour_brewer(palette = "Dark2", name = "Model") +
scale_shape_manual(values = rep(16, length(names_list))) +
guides(color = rev(guide_legend(override.aes = list(shape = 16)))) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 12),
legend.title = element_text(size = 11, face = "bold"),
legend.text = element_text(size = 10)
)
print("Returning plot")
print(class(plot))
return(plot)
}
affpol_components <- plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components <- (plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4))) + theme_minimal()
affpol_components <- (plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4))) + theme_minimal()
affpol_components <- plot_generate_7b(models_list, names_list, "Test", c(-0.6, 0.4))
print(class(affpol_components))  # Should be "gg" "ggplot"
plot <- base_plot +
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals") +
ggplot2::xlim(xlim) +
scale_colour_brewer(palette = "Dark2", name = "Model") +
scale_shape_manual(values = rep(16, length(names_list))) +
guides(color = rev(guide_legend(override.aes = list(shape = 16)))) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 12),
legend.title = element_text(size = 11, face = "bold"),
legend.text = element_text(size = 10)
)
#### Seven Models Fix ####
plot_generate_7b <- function(models_list, names_list, plot_title, xlim) {
models <- lapply(models_list, function(model) {
print("Tidying model")
tidy_model <- broom::tidy(coeftest(model, vcov = sandwich::vcovHC, type = "HC1"))
print(class(tidy_model))
tidy_model %>%
filter(term != "(Intercept)")
})
print("Tidied all models")
names_df <- lapply(names_list, function(name) {
data.frame(model = rep(name, nrow(models[[1]])))
})
models <- Map(cbind, models, names_df)
models <- do.call(rbind, models)
print("Creating dwplot")
base_plot <- dotwhisker::dwplot(models,
vline = geom_vline(xintercept = 0, linetype = "dashed", color = "black"),
dot_args = list(size = 5),
whisker_args = list(size = 0.7),
dodge_size = 1)
print("After dwplot")
print(class(base_plot))
base_plot <- dotwhisker::relabel_predictors(
base_plot,
treat_long_collapse2 = "Long Video vs. Placebo"
)
print("After relabel_predictors")
print(class(base_plot))
plot <- base_plot +
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals") +
ggplot2::xlim(xlim) +
scale_colour_brewer(palette = "Dark2", name = "Model") +
scale_shape_manual(values = rep(16, length(names_list))) +
guides(color = rev(guide_legend(override.aes = list(shape = 16)))) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 12),
legend.title = element_text(size = 11, face = "bold"),
legend.text = element_text(size = 10)
)
print("Returning plot")
print(class(plot))
return(plot)
}
affpol_components <- plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components <- (plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4))) + theme_minimal()
affpol_components <- plot_generate_7b(models_list, names_list, "Test", c(-0.6, 0.4))
affpol_components <- plot_generate_7b(models_list, names_list, "Test", c(-0.6, 0.4))
#### Seven Models Fix ####
plot_generate_7b <- function(models_list, names_list, plot_title, xlimits) {
models <- lapply(models_list, function(model) {
print("Tidying model")
tidy_model <- broom::tidy(coeftest(model, vcov = sandwich::vcovHC, type = "HC1"))
print(class(tidy_model))
tidy_model %>%
filter(term != "(Intercept)")
})
print("Tidied all models")
names_df <- lapply(names_list, function(name) {
data.frame(model = rep(name, nrow(models[[1]])))
})
models <- Map(cbind, models, names_df)
models <- do.call(rbind, models)
print("Creating dwplot")
base_plot <- dotwhisker::dwplot(models,
vline = geom_vline(xintercept = 0, linetype = "dashed", color = "black"),
dot_args = list(size = 5),
whisker_args = list(size = 0.7),
dodge_size = 1)
print("After dwplot")
print(class(base_plot))
base_plot <- dotwhisker::relabel_predictors(
base_plot,
treat_long_collapse2 = "Long Video vs. Placebo"
)
print("After relabel_predictors")
print(class(base_plot))
plot <- base_plot +
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals") +
ggplot2::xlim(xlimits) +
scale_colour_brewer(palette = "Dark2", name = "Model") +
scale_shape_manual(values = rep(16, length(names_list))) +
guides(color = rev(guide_legend(override.aes = list(shape = 16)))) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 12),
legend.title = element_text(size = 11, face = "bold"),
legend.text = element_text(size = 10)
)
print("Returning plot")
print(class(plot))
return(plot)
}
affpol_components <- plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components <- (plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4))) + theme_minimal()
affpol_components <- (plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)))
print(xlim)
plot_generate_7b(models_list, names_list, "Test", c(-0.6, 0.4))
#### Seven Models Fix ####
plot_generate_7b <- function(models_list, names_list, plot_title, x_limits) {
library(broom)
library(sandwich)
library(dotwhisker)
library(dplyr)
library(ggplot2)
models <- lapply(models_list, function(model) {
message("Tidying model")
coeftest(model, vcov = vcovHC, type = "HC1") %>%
tidy() %>%
filter(term != "(Intercept)")
})
message("Tidied all models")
# Make sure all models have the same number of terms
term_counts <- sapply(models, nrow)
if(length(unique(term_counts)) != 1) {
stop("All models must have the same number of coefficients to bind correctly.")
}
names_df <- mapply(function(name, model_df) {
data.frame(model = rep(name, nrow(model_df)))
}, names_list, models, SIMPLIFY = FALSE)
models <- Map(cbind, models, names_df)
models_df <- do.call(rbind, models)
message("Creating dwplot")
p <- tryCatch({
dwplot(models_df,
vline = geom_vline(xintercept = 0, linetype = "dashed", color = "black"),
dot_args = list(size = 5),
whisker_args = list(size = 0.7),
dodge_size = 1
)
}, error = function(e) {
stop("dwplot failed: ", e$message)
})
message("After dwplot")
print(class(p))
p <- tryCatch({
relabel_predictors(p, treat_long_collapse2 = "Long Video vs. Placebo")
}, error = function(e) {
stop("relabel_predictors failed: ", e$message)
})
message("After relabel_predictors")
print(class(p))
# Ensure x_limits is numeric
if (!is.numeric(x_limits) || length(x_limits) != 2) {
stop("x_limits must be a numeric vector of length 2.")
}
# Add aesthetics and return
p <- p +
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals") +
ggplot2::xlim(x_limits) +
scale_colour_brewer(palette = "Dark2", name = "Model") +
scale_shape_manual(values = rep(16, length(names_list))) +
guides(color = guide_legend(override.aes = list(shape = 16))) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 12),
legend.title = element_text(size = 11, face = "bold"),
legend.text = element_text(size = 10)
)
message("Final plot built successfully.")
return(p)
}
affpol_components <- plot_generate_7b(models_list, names_list, "Test", c(-0.6, 0.4))
affpol_components
affpol_components <- plot_generate_7b(models_list, names_list, "Affective Polarization Index Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components
ggsave("Figures/SI/Figure_SI.9.png", plot = affpol_components, width=10, height=7)
therm_out <- lm(therm_outparty_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
trust_out <- lm(trust_outparty_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp)
models_list2 <- list(therm_out, trust_out, discomfort_marr, discomfort_friend, discomfort_neighbor, threat, neg_par)
names_list2 <- c("Feeling Thermometer Outparty", "Trust Outparty","Discomfort Marriage", "Discomfort Friends", "Discomfort Neighbors", "Outparty Threat", "Negative Partisanship")
affpol_components_outparty <- plot_generate_7b(models_list2, names_list2, "Affective Polarization Index (Outparty Only): Breakdown by Component", c(-0.6, 0.4)) + theme_minimal()
affpol_components_outparty
ggsave("Figures/SI/Figure_SI.10.png", plot = affpol_components_outparty, width=10, height=7)
final_drops <- final_drops %>%
mutate(
therm_inparty_scale = scale(therm_inparty),
therm_inparty_w3_scale = scale(therm_inparty_w3),
trust_inparty_scale = scale(trust_inparty),
trust_inparty_w3_scale = scale(trust_inparty_w3)
)
trust_inparty_only <- lm_robust(trust_inparty_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
therm_inparty_only <- lm_robust(therm_inparty_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
get_table_2(trust_inparty_only, therm_inparty_only, "Effect of Documentary on Ingroup Affective Polarization Measures","Ingroup Trust", "Ingroup Warmth")
#### Figure SI.11 ####
HTE1.3_dialogue <- lm(dialogue_scale~treat_long_collapse2*partyID, final_drops, weights = ipw_matched_w2_noimp)
#generate df and plot
HTE1.3_df <- get_cate(HTE1.3_dialogue, "Democrats", "Republicans")
dialogue_cate <- plot_cate(HTE1.3_df, "A: Dialogue Effectiveness", c(-0.5,1))
dialogue_cate
#optimism about restoring civility
HTE1.5_optimism_civil <- lm(optimism_civil_scale~treat_long_collapse2*partyID, final_drops, weights = ipw_matched_w2_noimp)
#generate df and plot
HTE1.5_df <- get_cate(HTE1.5_optimism_civil, "Democrats", "Republicans")
optimism_civil_cate <- plot_cate(HTE1.5_df, "B: Restoring Civility and Goodwill", c(-0.5,1))
optimism_civil_cate
#optimism about survival of democratic institutions
HTE1.6_optimism_survive <- lm(optimism_survive_scale~treat_long_collapse2*partyID, final_drops, weights = ipw_matched_w2_noimp)
#generate df and plot
HTE1.6_df <- get_cate(HTE1.6_optimism_survive, "Democrats", "Republicans")
optimism_democracy_cate <- plot_cate(HTE1.6_df, "C: Survival of Democratic Institutions", c(-0.5,1))
optimism_democracy_cate
#non-violent change still possible
HTE1.8_nonviol <- lm(nonviol_change_scale~treat_long_collapse2*partyID, final_drops, weights = ipw_matched_w2_noimp)
#generate df and plot
HTE1.8_df <- get_cate(HTE1.8_nonviol, "Democrats", "Republicans")
nonviol_cate <- plot_cate(HTE1.8_df, "D: Non-Violent Change", c(-1,1))
nonviol_cate
library(patchwork)
combined_secondary_HTE_plots <- dialogue_cate + optimism_civil_cate+ optimism_democracy_cate + nonviol_cate + plot_layout(guides = "collect")
#save
ggsave("Figures/SI/Figure_SI.12.png", plot = combined_secondary_HTE_plots, width=10, height=7)
#### Figure SI.12 ####
combined_secondary_HTE_plots
#### Figure SI.12 ####
antidem_cate_ID <- lm(antidem_idx~treat_long_collapse2*partyID, final_drops, weights = ipw_matched_w2_noimp)
antidem_partyID <- get_cate(antidem_cate_ID, "Democrats", "Republicans")
antidem_partyID_plot <- plot_cate(antidem_partyID, "CATE Anti-Democratic Attitudes Party ID:
Nationally Representative Sample Wave 2", c(-0.5,0.5))
antidem_partyID_plot
ggsave("Figures/SI/Figure_SI.12.png", plot = antidem_partyID_plot, width=10, height=7)
# Create time bins by 24 hours
final_drops <- final_drops %>%
mutate(
time_bins = case_when(
post_treat_w2 <= 24 ~ 0,  # First bin: 24 hours or less
post_treat_w2 > 24 & post_treat_w2 <= 48 ~ 1,  # Second bin: 25-48 hours
post_treat_w2 > 48 & post_treat_w2 <= 72 ~ 2,  # Third bin: 49-72 hours
post_treat_w2 > 72 & post_treat_w2 <= 96 ~ 3,  # Fourth bin: 73-96 hours
post_treat_w2 > 96 & post_treat_w2 <= 120 ~ 4, # Fifth bin: 97-120 hours
post_treat_w2 > 120 & post_treat_w2 <= 144 ~ 5, # Sixth bin: 121-144 hours
post_treat_w2 > 144 & post_treat_w2 <= 168 ~ 6, # Seventh bin: 145-168 hours
post_treat_w2 > 168 & post_treat_w2 <= 192 ~ 7, # Eighth bin: 169-192 hours
post_treat_w2 > 192 & post_treat_w2 <= 216 ~ 8, # Ninth bin: 193-216 hours
post_treat_w2 > 216 ~ 9  # Tenth bin: 217 hours or more
)
)
by_time <- lm_robust(aff_pol_idx~treat_long_collapse2*time_bins, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
summary(by_time)
by_time_out <- lm_robust(aff_pol_idx_outparty~treat_long_collapse2*time_bins, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
summary(by_time_out)
#make table
get_table_2(by_time, by_time_out, "Affective Polarization by Wave 2 Response Time", "Affective Polarization", "Outparty Only")
#### Dichotomous (5 days) ####
final_drops <- final_drops %>%
mutate(
five_days = if_else(post_treat_w2 >= 120, 1,0)
)
by_five_days <- lm_robust(aff_pol_idx~treat_long_collapse2*five_days, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
summary(by_five_days)
by_five_days_out <- lm_robust(aff_pol_idx_outparty~treat_long_collapse2*five_days, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
get_table_2(by_five_days, by_five_days_out, "", "Affective Polarization", "Outparty Only")
#### Table SI.36 ####
# Create time bins by 24 hours
final_drops <- final_drops %>%
mutate(
time_bins = case_when(
post_treat_w2 <= 24 ~ 0,  # First bin: 24 hours or less
post_treat_w2 > 24 & post_treat_w2 <= 48 ~ 1,  # Second bin: 25-48 hours
post_treat_w2 > 48 & post_treat_w2 <= 72 ~ 2,  # Third bin: 49-72 hours
post_treat_w2 > 72 & post_treat_w2 <= 96 ~ 3,  # Fourth bin: 73-96 hours
post_treat_w2 > 96 & post_treat_w2 <= 120 ~ 4, # Fifth bin: 97-120 hours
post_treat_w2 > 120 & post_treat_w2 <= 144 ~ 5, # Sixth bin: 121-144 hours
post_treat_w2 > 144 & post_treat_w2 <= 168 ~ 6, # Seventh bin: 145-168 hours
post_treat_w2 > 168 & post_treat_w2 <= 192 ~ 7, # Eighth bin: 169-192 hours
post_treat_w2 > 192 & post_treat_w2 <= 216 ~ 8, # Ninth bin: 193-216 hours
post_treat_w2 > 216 ~ 9  # Tenth bin: 217 hours or more
)
)
by_time <- lm_robust(aff_pol_idx~treat_long_collapse2*time_bins, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
summary(by_time)
by_time_out <- lm_robust(aff_pol_idx_outparty~treat_long_collapse2*time_bins, final_drops, weights=ipw_matched_w2_noimp, se_type = "HC1")
summary(by_time_out)
#make table
get_table_2(by_time, by_time_out, "Affective Polarization by Wave 2 Response Time", "Affective Polarization", "Outparty Only")
summary(by_time)
summary(by_time_out)
#### Figure SI.13 ####
#belief in possibility of non-violent democratic change
Y1.1_w3 <- lm(nonviol_change_scale_w3~treat_long_collapse2, final_drops, weights = ipw_matched_w3_noimp)
Y1.4_w3 <- lm(dialogue_scale_w3~treat_long_collapse2, final_drops, weights = ipw_matched_w3_noimp)
Y2.1_w3 <- lm(optimism_civil_scale_w3~treat_long_collapse2, final_drops, weights = ipw_matched_w3_noimp)
Y2.2_w3 <- lm(optimism_survive_scale_w3~treat_long_collapse2, final_drops, weights = ipw_matched_w3_noimp)
optimism_plot_PAP_w3 <- plot_generate_4(Y1.1_w3, Y1.4_w3, Y2.1_w3, Y2.2_w3, "Non-Violent Change Still Possible", "Belief in Efficacy of Dialogue","Restoring Civility", "Survival of Democratic Institutions","", c(-0.3, .6))
print(optimism_plot_PAP_w3)
#save
ggsave("Figures/SI/Figure_SI.13.png", plot = optimism_plot_PAP_w3, width=10, height=7)
#### Table SI.37 ####
#HTEs covariates
covars <- c("age", "sex", "educ_dum", "white", "christian", "child", "job", "marr_dum", "turnout2020", "ideo_scale")
covars_formula <- paste(covars, collapse = " + ")
formula <- as.formula(paste("aff_pol_idx ~ treat_long_collapse2 * partyID +", covars_formula))
HTE1.1_covars <- lm_robust(formula, data = final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
HTE1.1_covars_2 <- lm(formula, data = final_drops, weights = ipw_matched_w2_noimp)
summary(HTE1.1_covars_2)
#HTEs covariates outparty
formula_out <- as.formula(paste("aff_pol_idx_outparty ~ treat_long_collapse2 * partyID +", covars_formula))
HTE1.1_covars_out <- lm_robust(formula_out, data = final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
summary(HTE1.1_covars_out)
HTE1.1_covars_out_2 <- lm(formula_out, data = final_drops, weights = ipw_matched_w2_noimp)
#create table
get_table_2(HTE1.1_covars, HTE1.1_covars_out, "", "Affective polarization", "Outparty only")
#### Table SI.38 ####
L1.1 <- lm_robust(optimism_pol_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
L1.2 <- lm_robust(optimism_pol_scale~treat_long_collapse2, final_drops, weights = weight_w2, se_type = "HC1")
L1.3 <- lm_robust(optimism_pol_scale~treat_long_collapse2, final_drops, weights = ipw_full_w2_noimp, se_type = "HC1")
L1.4 <- lm_robust(optimism_pol_scale~treat_long_collapse2, final_drops, se_type = "HC1")
get_table_4(L1.1, L1.2, L1.3, L1.4, "Main Analysis: Optimism about Overcoming Polarization Wave 2 (Long vs. Placebo)", "Matched (IPWs)", "Matched (No IPWs)", "Full (IPWs)", "Full (No IPWs)")
#### Table SI.39 ####
Y1.1 <- lm_robust(rebuild_trust_scale~treat_long_collapse2, final_drops, weights = ipw_matched_w2_noimp, se_type = "HC1")
Y1.2 <- lm_robust(rebuild_trust_scale~treat_long_collapse2, final_drops, weights = weight_w2, se_type = "HC1")
Y1.3 <- lm_robust(rebuild_trust_scale~treat_long_collapse2, final_drops, weights = ipw_full_w2_noimp, se_type = "HC1")
Y1.4 <- lm_robust(rebuild_trust_scale~treat_long_collapse2, final_drops, se_type = "HC1")
get_table_4(Y1.1, Y1.2, Y1.3, Y1.4, "Main Analysis: Time It Would Take to Rebuild Trust (reverse-coded) Wave 2 (Long vs. Placebo)", "Matched (IPWs)", "Matched (No IPWs)", "Full (IPWs)", "Full (No IPWs)")
#### Figure SI.14 ####
#both short videos vs. long video
final_drops <- final_drops %>%
mutate(
treat_shortlong_collapse =
case_when(
video_treatment == "Treatment Long" ~ 1,
video_treatment == "Treatment Short PMC" ~ 0,
video_treatment == "Treatment Short VC" ~ 0
)
)
#polarization
full_vs_short <- lm(aff_pol_idx~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#outparty
full_vs_short_out <- lm(aff_pol_idx_outparty~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#BA newsletter
full_vs_short_newsletter <- lm(BA_newsletter_clicked~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#donation
full_vs_short_donate <- lm(donate_any~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
short_vs_long_plot <- plot_generate_4_2(full_vs_short, full_vs_short_out, full_vs_short_newsletter, full_vs_short_donate, "Affective Polarization", "Outparty Only", "BA Newsletter", "Any Donation", "", c(-.2, .2))
#### Four Models Alt####
plot_generate_4_2 <- function(model_x, model_y, model_z, model_t, name_x, name_y, name_z, name_t, plot_title, xlim) {
#convert models into tidy dataframes with Robust SEs
new_model_x <- coeftest(model_x, vcov=vcovHC, type="HC1") #robust SEs for model x
new_model_y <- coeftest(model_y, vcov=vcovHC, type="HC1") #robust SEs for model y
new_model_z <- coeftest(model_z, vcov=vcovHC, type="HC1") #robust SEs for model z
new_model_t <- coeftest(model_t, vcov=vcovHC, type="HC1") #robust SEs for model t
name_x_df <- tidy(new_model_x) #create df
name_x_df <- name_x_df %>% filter(term != "(Intercept)") %>% mutate(model = {{name_x}}) #remove intercept
name_y_df <- tidy(new_model_y) #create df
name_y_df <- name_y_df %>% filter(term != "(Intercept)") %>% mutate(model = {{name_y}}) #remove intercept
name_z_df <- tidy(new_model_z) #create df
name_z_df <- name_z_df %>% filter(term != "(Intercept)") %>% mutate(model = {{name_z}})#remove intercept
name_t_df <- tidy(new_model_t) #create df
name_t_df <- name_t_df %>% filter(term != "(Intercept)") %>% mutate(model = {{name_t}})#remove intercept
models <- rbind(name_x_df, name_y_df, name_z_df, name_t_df)
#plot
plot <- dwplot(models,
vline = geom_vline(
xintercept = 0,
linetype= "dashed",
color = "black"),
dot_args = list(size=5, shape=c(15,16,17,18)),
whisker_args = list(size=0.7),
dodge_size = 1
) %>%
relabel_predictors(treat_shortlong_collapse = "Intention-To-Treat Effect
of Vicarious Contact")+
ggtitle(plot_title) +
xlab("Coefficient Estimate with 95% Confidence Intervals")+
xlim(xlim)+
scale_colour_manual(
name = "Legend",
labels = list(models$model[4], models$model[3], models$model[2], models$model[1]),
values = list("black", "black", "black", "black")
)+
scale_shape_manual(
name= "Legend",
labels = list(models$model[4], models$model[3],models$model[2], models$model[1]),
values=list(15,16, 17, 18)
)+
guides(color = guide_legend(override.aes=list(shape=c(15:18))))+
theme_bw()+
theme(plot.title = element_text(size=14, face="bold"),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size=12),
legend.title = element_text(size=11, face="bold"),
legend.text = element_text(size=10))
coef_1 <- format(round(c(models$estimate[1]), 3), nsmall=3)
coef_2 <- format(round(c(models$estimate[2]), 3), nsmall=3)
coef_3 <- format(round(c(models$estimate[3]), 3), nsmall=3)
coef_4 <- format(round(c(models$estimate[4]), 3), nsmall=3)
plot +
annotate(x=models$estimate[4], y=1.45, label=coef_4,geom="label", color="black")+
annotate(x=models$estimate[3], y=1.2, label=coef_3,geom="label", color="black")+
annotate(x=models$estimate[2], y=0.8, label=coef_2,geom="label", color="black")+
annotate(x=models$estimate[1], y=0.55, label=coef_1,geom="label", color="black")
}
#### Figure SI.14 ####
#both short videos vs. long video
final_drops <- final_drops %>%
mutate(
treat_shortlong_collapse =
case_when(
video_treatment == "Treatment Long" ~ 1,
video_treatment == "Treatment Short PMC" ~ 0,
video_treatment == "Treatment Short VC" ~ 0
)
)
#polarization
full_vs_short <- lm(aff_pol_idx~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#outparty
full_vs_short_out <- lm(aff_pol_idx_outparty~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#BA newsletter
full_vs_short_newsletter <- lm(BA_newsletter_clicked~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
#donation
full_vs_short_donate <- lm(donate_any~treat_shortlong_collapse, final_drops, weights = ipw_matched_w2_noimp)
short_vs_long_plot <- plot_generate_4_2(full_vs_short, full_vs_short_out, full_vs_short_newsletter, full_vs_short_donate, "Affective Polarization", "Outparty Only", "BA Newsletter", "Any Donation", "", c(-.2, .2))
short_vs_long_plot
#save
ggsave("Figures/SI/Figure_SI.14.png", plot = short_vs_long_plot, width=10, height=7)
